home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb30.arc / XREFPAS.PAS < prev   
Pascal/Delphi Source File  |  1985-04-15  |  7KB  |  254 lines
  1. program xrefpas;
  2. (*
  3.  Cross reference generator
  4.  
  5.  Usage: XREFPAS filename   (subdirectories not supported)
  6.  
  7.  >>>> This must be compiled by Turbo Pascal(tm) before running <<<<
  8. *)
  9. const
  10.   c1 = 10; { characters per word }
  11.   c2 = 12; { line numbers per printed reference line }
  12.   c3 =  5; { size of displayed line numbers }
  13. type
  14.   wordref = ^word;
  15.   itemref = ^item;
  16.   word = record key: string[c1];
  17.                 first, last: itemref;
  18.                 left, right: wordref;
  19.          end ;
  20.   item = record lno: integer;
  21.                 next: itemref;
  22.          end ;
  23.   state = (none,symbol,quote,com1,pcom2,com2,pcom2x);
  24. var
  25.   param: string[127] absolute cseg:$0080;
  26.   fname: string[14];
  27.   root:  wordref;
  28.   n:     integer;
  29.   id:    string[127];
  30.   fv:    text;
  31.   f:     char;
  32.   scan:  state;
  33.   pageno:integer;
  34.   title: string[4];
  35. procedure newpage;
  36.   begin
  37.     pageno := pageno+1;
  38.     write(lst,#12,title,': ',fname,' ':50,'Page ',pageno:3);
  39.     writeln(lst);
  40.     writeln(lst);
  41.   end {newpage};
  42. procedure writeid;
  43.   function rsvdword: boolean;
  44.     const
  45.       wordlist: array[1..43] of string[9] =
  46.         ('ABSOLUTE','AND','ARRAY','BEGIN','CASE','CONST','DIV',
  47.          'DO','DOWNTO','ELSE','END','EXTERNAL','FILE','FOR',
  48.          'FORWARD','FUNCTION','GOTO','IF','IN','INLINE','LABEL',
  49.          'MOD','NIL','NOT','OF','OR','PACKED','PROCEDURE',
  50.          'PROGRAM','RECORD','REPEAT','SET','SHL','SHR','STRING',
  51.          'THEN','TO','TYPE','UNTIL','VAR','WHILE','WITH','XOR');
  52.     var
  53.       i, j, k: integer;
  54.       upid:    string[127];
  55.     begin
  56.       upid := '';
  57.       for i := 1 to length(id) do
  58.         upid := upid + upcase(copy(id,i,1));
  59.       i := 1;
  60.       j := 43;
  61.       repeat
  62.         k := (i+j) div 2;
  63.         if upid > wordlist[k] then i := k+1
  64.                             else j := k
  65.     until i = j;
  66.     rsvdword := (upid = wordlist[i])
  67.     end {rsvdword};
  68.   procedure search (var w1: wordref);
  69.     var w: wordref;
  70.         x: itemref;
  71.     begin
  72.       w := w1;
  73.       if w = nil then
  74.       begin
  75.         new(w);
  76.         new(x);
  77.         with w^ do
  78.         begin
  79.           key := id;
  80.           left := nil;
  81.           right := nil;
  82.           first := x;
  83.           last := x
  84.         end ;
  85.         x^.lno := n;
  86.         x^.next := nil;
  87.         w1 := w
  88.       end
  89.       else
  90.       if id < w^.key then search(w^.left)
  91.       else
  92.       if id > w^.key then search(w^.right)
  93.       else
  94.       begin
  95.         new(x);
  96.         x^.lno := n;
  97.         x^.next := nil;
  98.         w^.last^.next := x;
  99.         w^.last := x
  100.       end
  101.     end {search} ;
  102.   begin
  103.     if rsvdword then
  104.     begin
  105.       write(lst,#27,#69,id,#27,#70)
  106.     end
  107.     else
  108.     begin
  109.       write(lst,id);
  110.       search(root)
  111.     end
  112.   end {writeid};
  113. procedure printtree (w:wordref);
  114.   procedure printword (w:word);
  115.     var l: integer;
  116.         x: itemref;
  117.     begin
  118.       if (n mod 60) = 0 then newpage;
  119.       write(lst,' ',w.key:c1);
  120.       x := w.first;
  121.       l:= 0;
  122.       repeat
  123.         if l = c2 then
  124.         begin
  125.           writeln(lst);
  126.           n := n+1;
  127.           if (n mod 60) = 0 then newpage;
  128.           write(lst,' ':c1+1);
  129.           l := 0
  130.         end ;
  131.         l := l+1;
  132.         write(lst,x^.lno:c3);
  133.         x := x^.next
  134.       until x = nil;
  135.     writeln(lst);
  136.     n := n+1
  137.     end {printword} ;
  138.   begin if w <> nil then
  139.     begin
  140.       printtree(w^.left);
  141.       printword(w^);
  142.       printtree(w^.right)
  143.     end
  144.   end {printtree} ;
  145. begin
  146.   n := 0;
  147.   repeat
  148.     n := n+1
  149.   until (n > length(param)) or (param[n] <> ' ');
  150.   fname := copy(param,n,length(param)-n+1);
  151.   assign(fv,fname);
  152.   reset(fv);
  153.   root := nil;
  154.   n := 0;
  155.   scan := none;
  156.   pageno := 0;
  157.   title := 'List';
  158.   while not eof(fv) do
  159.   begin
  160.     if (n mod 60) = 0 then newpage;
  161.     n := n+1;
  162.     write(lst,n:c3,' ');
  163.     while not eoln(fv) do
  164.     begin
  165.       read(fv,f);
  166.       case scan of
  167.         none:   begin
  168.                   if f in['a'..'z','A'..'Z','_'] then
  169.                   begin
  170.                     id := f;
  171.                     scan := symbol
  172.                   end
  173.                   else
  174.                   begin
  175.                     write(lst,f);
  176.                     if f = '''' then scan := quote
  177.                     else
  178.                     if f = '{' then scan := com1
  179.                     else
  180.                     if f = '(' then scan := pcom2
  181.                   end
  182.                 end;
  183.         symbol: begin
  184.                   if f in['a'..'z','A'..'Z','0'..'9','_'] then
  185.                   begin
  186.                     id := id + f;
  187.                   end
  188.                   else
  189.                   begin
  190.                     writeid;
  191.                     write(lst,f);
  192.                     if f = '''' then scan := quote
  193.                     else
  194.                     if f = '{' then scan := com1
  195.                     else
  196.                     if f = '(' then scan := pcom2
  197.                     else
  198.                     scan := none
  199.                   end
  200.                 end;
  201.         quote:  begin
  202.                   write(lst,f);
  203.                   if f = '''' then scan := none
  204.                 end;
  205.         com1:   begin
  206.                   write(lst,f);
  207.                   if f = '}' then scan := none
  208.                 end;
  209.         pcom2:  begin
  210.                   if f in['a'..'z','A'..'Z','_'] then
  211.                   begin
  212.                     id := f;
  213.                     scan := symbol
  214.                   end
  215.                   else
  216.                   begin
  217.                     write(lst,f);
  218.                     if f = '''' then scan := quote
  219.                     else
  220.                     if f = '{' then scan := com1
  221.                     else
  222.                     if f = '(' then scan := pcom2
  223.                     else
  224.                     if f = '*' then scan := com2
  225.                     else
  226.                     scan := none
  227.                   end
  228.                 end;
  229.         com2:   begin
  230.                   write(lst,f);
  231.                   if f = '*' then scan := pcom2x
  232.                 end;
  233.         pcom2x: begin
  234.                   write(lst,f);
  235.                   if f = ')' then scan := none
  236.                              else scan := com2
  237.                 end;
  238.       end;
  239.     end;
  240.     if scan = symbol then
  241.     begin
  242.       writeid;
  243.       scan := none
  244.     end;
  245.     writeln(lst);
  246.     readln(fv);
  247.   end;
  248.   n := 0;
  249.   pageno := 0;
  250.   title := 'xref';
  251.   printtree(root);
  252.   write(lst,#12)
  253. end.
  254.